home *** CD-ROM | disk | FTP | other *** search
/ Garbo / Garbo.cdr / mac / progrmng / mlpmodul.sit / MacLogimoPlus Documentation / sample code / smallControl.mod < prev    next >
Encoding:
Text File  |  1990-06-14  |  14.4 KB  |  335 lines  |  [TEXT/PMED]
  1. MODULE smallControl; (* 28.05.85 / Franz Kronseder *)
  2.                      (* last modified 31.05.85     *)
  3.                      (* this test program intends to try out the Toolbox routines *)
  4.                      (* of the Macintosh Control Manager.                         *)
  5.                      (* there are two windows, one for the Control Features and   *)
  6.                      (* one for the Test-I/O Terminal. *)
  7.  
  8. FROM SYSTEM IMPORT ADR,ADDRESS;
  9. FROM MacBase IMPORT RootRecord;
  10. FROM QuickDrawTypes IMPORT GrafPtr,Rect,QDGPointer,Pattern;
  11. FROM QuickDraw1 IMPORT GetPort,SetPort,DrawString,SetRect,FillRect,EraseRect,
  12.                        TextFont,TextSize,GlobalToLocal;
  13. FROM Terminal IMPORT ReadString,Read,Write,WriteLn,WriteString,ClearTerminal;
  14. FROM OutTerminal IMPORT WriteI,WriteB,WriteC;
  15. FROM PascalStrings IMPORT MakePascalString,MakeModulaString;
  16. FROM EventMgr IMPORT EventRecord,abortEvt,everyEvent,abortMask,EventAvail,
  17.                      FlushEvents,PostEvent,
  18.                      mouseDown,activateEvt,updateEvt;
  19. FROM WindowMgr IMPORT WindowRecord,WindowPtr,DocumentProc,DBoxProc,RDocProc,
  20.                       GetWMgrPort,NewWindow,CloseWindow,FrontWindow,SelectWindow,
  21.                       FindWindow,BeginUpdate,EndUpdate,
  22.                       DragWindow,SizeWindow,GrowWindow,
  23.                       inDrag,inGrow,inGoAway,inContent;
  24. FROM EventShell IMPORT addrearHandler,removeHandler,EventHandler;
  25. FROM TextEdit IMPORT TextBox,teJustCenter;
  26. FROM ControlMgr IMPORT ControlHandle,NewControl,KillControls,
  27.                        ShowControl,HideControl,DrawControls,FindControl,
  28.                        TrackControl,GetCtlValue,SetCtlValue,GetCTitle,SetCTitle,
  29.                        HiliteControl,
  30.                        ScrollBarProc,RadioButProc,CheckBoxProc,PushButProc,
  31.                        noControl,inButton,inCheckbox,inUpButton,inDownButton,
  32.                        inPageUp,inPageDown,inThumb;
  33.  
  34. (*-----------------------------------------------------------------------------*)
  35. CONST systemFont=0; Monaco=4;
  36.       activateBit=0;
  37. TYPE OsErr=INTEGER;
  38. (*-----------------------------------------------------------------------------*)
  39. VAR TSData : RECORD TSW:WindowPtr;
  40.                  TSWstorage:WindowRecord;
  41.                  TSWHandlerProc:EventHandler;
  42.                  TSWHid:CARDINAL;
  43.            END;
  44.     (* TSD=Test Screen Data, TSW=Test Screen Window *)
  45.  
  46. PROCEDURE EnterTestScreen;
  47.  (* put the Input/Output via MODULE Terminal into a Window called "Test Screen" *)
  48.  CONST visible=TRUE;
  49.  VAR TSWtitle: ARRAY[0..40] OF CHAR; boundsRect:Rect; ok:BOOLEAN;
  50.      WPort:GrafPtr;
  51.  BEGIN PaintScreenGray;
  52.   WITH TSData DO
  53.   GetWMgrPort(WPort); SetPort(WPort); TextFont(systemFont); TextSize(12);
  54.   SetRect(boundsRect,5,250,405,340); MakePascalString("Test Screen",TSWtitle);
  55.   TSW:=NewWindow(ADR(TSWstorage),boundsRect,ADR(TSWtitle),visible,
  56.                  DocumentProc,MacNIL,FALSE,ADR(TSData));
  57.   SetPort(TSW); TextFont(Monaco); TextSize(9);ClearTerminal;
  58.   addrearHandler(TSWHandler,TSWHid,ok);
  59.   END(*with*);END EnterTestScreen;
  60.  
  61. PROCEDURE LeaveTestScreen;
  62.  VAR ok:BOOLEAN;
  63.  BEGIN WITH TSData DO
  64.   CloseWindow(TSW); removeHandler(TSWHid,ok);
  65.  END(*with*); END LeaveTestScreen;
  66.  
  67. PROCEDURE TSWHandler (VAR event:EventRecord):BOOLEAN;
  68.  VAR findcode:INTEGER; whichWindow:WindowPtr; boundsRect:Rect;
  69.      savePort,wPort:GrafPtr; growResult:ADDRESS;
  70.  BEGIN WITH TSData DO WITH event DO
  71.  CASE event.what
  72.   OF mouseDown:
  73.       findcode:=FindWindow(where.h,where.v,whichWindow);
  74.       IF (whichWindow=TSW)
  75.        THEN IF (FrontWindow()=TSW)
  76.              THEN GetPort(savePort); GetWMgrPort(wPort); SetPort(wPort);
  77.                   CASE findcode
  78.                    OF inDrag: SetRect(boundsRect,4,24,508,300);
  79.                               DragWindow(whichWindow,where.h,where.v,boundsRect);
  80.                     | inGrow: SetRect(boundsRect,4,24,508,300);
  81.                              growResult:=GrowWindow(whichWindow,where.h,where.v,boundsRect);
  82.                              SizeWindow(whichWindow,INTEGER(growResult MOD ADDRESS(10000H)),
  83.                                                     INTEGER(growResult DIV ADDRESS(10000H)),FALSE);
  84.                    ELSE
  85.                    END;(*case findcode*)
  86.                    SetPort(savePort);
  87.               ELSE SelectWindow(TSW); SetPort(TSW);
  88.               END;(*if*)
  89.              RETURN TRUE;
  90.        ELSE RETURN FALSE;
  91.        END;(*if*)
  92.   | updateEvt: IF (ADDRESS(message)=TSW)
  93.                 THEN BeginUpdate(TSW); EndUpdate(TSW);
  94.                      RETURN TRUE;
  95.                 ELSE RETURN FALSE;
  96.                 END; (*if*)
  97.   | activateEvt: IF (ADDRESS(message)=TSW)
  98.                   THEN
  99.                        RETURN TRUE;
  100.                   ELSE RETURN FALSE;
  101.                   END;
  102.  
  103.   ELSE RETURN FALSE; (* don't handle this event *)
  104.   END;(*case*)
  105.  END;(*with*) END;(*with*) END TSWHandler;
  106.  
  107.  PROCEDURE PaintScreenGray;
  108.  VAR ScreenPort:GrafPtr;
  109.      QDGPtr:QDGPointer; GrayPtr : POINTER TO Pattern;
  110.  BEGIN   QDGPtr:=RootRecord.patch3; GrayPtr:=ADR(QDGPtr^.gray );
  111.          (* this is still a bit complicated, because QuickDraw doesn't *)
  112.          (* yet export the QuickDraw global variables properly         *)
  113.          GetPort(ScreenPort);
  114.          FillRect(ScreenPort^.portRect,GrayPtr^);
  115.  END PaintScreenGray;
  116.  
  117.  PROCEDURE note(VAR text:ARRAY OF CHAR);
  118.   (* write the text to the Test Screen Window *)
  119.   VAR savePort:GrafPtr;
  120.   BEGIN GetPort(savePort); SetPort(TSData.TSW);
  121.         WriteString(text); WriteLn; Write(' ');
  122.         SetPort(savePort);
  123.   END note;
  124.  
  125.  PROCEDURE noteI(VAR text:ARRAY OF CHAR;i:INTEGER);
  126.   (* write the text to the Test Screen Window *)
  127.   VAR savePort:GrafPtr;
  128.   BEGIN GetPort(savePort); SetPort(TSData.TSW);
  129.         WriteString(text);WriteI(i,5); WriteLn;  Write(' ');
  130.         SetPort(savePort);
  131.   END noteI;
  132.  
  133. (*-----------------------------------------------------------------------------*)
  134. VAR CSData : RECORD CSW:WindowPtr;
  135.                     CSWstorage:WindowRecord;
  136.                     CSWHandlerProc:EventHandler;
  137.                     CSWHid:CARDINAL;
  138.                     bar1,bar2,button1,button2,
  139.                     rb1,rb2,rb3,rb4,chk1,chk2,chk3,chk4 :ControlHandle;
  140.                     (* scrollbar, pushbutton , radiobutton, checkbox *)
  141.               END;
  142.     (* CSD=Control Screen Data, CSW=Control Screen Window *)
  143.  
  144. PROCEDURE EnterControlScreen;
  145.  CONST visible=TRUE;
  146.  VAR CSWtitle: ARRAY[0..40] OF CHAR; boundsRect:Rect; ok:BOOLEAN;
  147.      savePort,WPort:GrafPtr;
  148.  BEGIN   WITH CSData DO
  149.   GetPort(savePort);GetWMgrPort(WPort); SetPort(WPort); TextFont(systemFont); TextSize(12);
  150.   SetRect(boundsRect,20,40,450,200); MakePascalString("Control Screen",CSWtitle);
  151.   CSW:=NewWindow(ADR(CSWstorage),boundsRect,ADR(CSWtitle),visible,
  152.                  DocumentProc,MacNIL,FALSE,ADR(TSData));
  153.   addrearHandler(CSWHandler,CSWHid,ok);
  154.   MakeControls; SetPort(savePort);
  155.   END(*with*);
  156.  END EnterControlScreen;
  157.  
  158. PROCEDURE LeaveControlScreen;
  159.  VAR ok:BOOLEAN;
  160.  BEGIN WITH CSData DO
  161.   RemoveControls;
  162.   CloseWindow(CSW); removeHandler(CSWHid,ok);
  163.  END(*with*); END LeaveControlScreen;
  164.  
  165. PROCEDURE CSWHandler (VAR event:EventRecord):BOOLEAN;
  166.  VAR findcode:INTEGER; growResult:ADDRESS; whichWindow:WindowPtr;
  167.      savePort,wPort:GrafPtr; boundsRect:Rect;
  168.  PROCEDURE handletheControls():BOOLEAN;
  169.   VAR theControl:ControlHandle; partCode:INTEGER;
  170.       Title,MTitle:ARRAY[0..63]OF CHAR;
  171.   BEGIN
  172.     partCode:=FindControl(event.where,CSData.CSW,theControl);
  173.     IF partCode=noControl
  174.      THEN note("noControl"); RETURN FALSE;
  175.      ELSE note("-----------------");
  176.           GetCTitle(theControl,ADR(Title));MakeModulaString(Title,MTitle);
  177.           note(MTitle);
  178.           CASE partCode
  179.             OF inButton:       note("inButton ");
  180.                                IF (GetCtlValue(theControl)=0)
  181.                                 THEN SetCtlValue(theControl,1);
  182.                                      HiliteControl(theControl,inButton);
  183.                                 ELSE SetCtlValue(theControl,0);
  184.                                      HiliteControl(theControl,0);
  185.                                 END;(*if*)
  186.             |  inCheckbox:     note("inCheckbox ");
  187.                                IF (GetCtlValue(theControl)=0)
  188.                                 THEN SetCtlValue(theControl,1);
  189.                                 ELSE SetCtlValue(theControl,0); END;(*if*)
  190.             |  inUpButton:     note("inUpButton ");
  191.             |  inDownButton:   note("inDownButton ");
  192.             |  inPageUp:       note("inPageUp ");
  193.             |  inPageDown:     note("inPageDown ");
  194.             |  inThumb:        note("inThumb ");
  195.                                noteI("TrackControl: ",
  196.                                      TrackControl(theControl,event.where,ADDRESS(-1)));
  197.             ELSE (*nothing*)
  198.             END;(*case partcode*)
  199.             noteI("GetCtlValue:  ",GetCtlValue(theControl));
  200.            RETURN TRUE;
  201.      END;(*if partCode *)
  202.   END handletheControls;
  203.  BEGIN WITH CSData DO WITH event DO (* body of CSWHandler *)
  204.  CASE event.what
  205.   OF mouseDown:
  206.       findcode:=FindWindow(where.h,where.v,whichWindow);
  207.       IF (whichWindow=CSW)
  208.        THEN GetPort(savePort); GetWMgrPort(wPort); SetPort(wPort);
  209.             IF (FrontWindow()=CSW)
  210.              THEN  CASE findcode
  211.                    OF inDrag: SetRect(boundsRect,4,24,508,300);
  212.                               DragWindow(whichWindow,where.h,where.v,boundsRect);
  213.                     | inGrow: SetRect(boundsRect,4,24,508,300);
  214.                              growResult:=GrowWindow(whichWindow,where.h,where.v,boundsRect);
  215.                              SizeWindow(whichWindow,INTEGER(growResult MOD ADDRESS(10000H)),
  216.                                                     INTEGER(growResult DIV ADDRESS(10000H)),FALSE);
  217.                     | inContent: SetPort(CSW);GlobalToLocal(where);
  218.                                  IF handletheControls()
  219.                                   THEN (*do nothing*)
  220.                                   ELSE
  221.                                   END;
  222.                    ELSE (*do nothing*)
  223.                    END;(*case findcode*)
  224.              ELSE SelectWindow(CSW);
  225.              END;(*if*)
  226.             SetPort(savePort);
  227.             RETURN TRUE;
  228.        ELSE RETURN FALSE;
  229.        END;(*if*)
  230.   | updateEvt: IF (ADDRESS(message)=CSW)
  231.                 THEN BeginUpdate(CSW); EndUpdate(CSW);
  232.                      RETURN TRUE;
  233.                 ELSE RETURN FALSE;
  234.                 END; (*if*)
  235.   | activateEvt: IF (ADDRESS(message)=CSW)
  236.                   THEN GetPort(savePort); GetWMgrPort(wPort); SetPort(wPort);
  237.                        IF activateBit IN modifiers
  238.                         THEN (*  activate*) DrawControls(CSW);
  239.                         ELSE (*deactivate*) SetPort(CSW); EraseRect(CSW^.portRect);
  240.                         END;
  241.                         SetPort(savePort);
  242.                        RETURN TRUE;
  243.                   ELSE RETURN FALSE;
  244.                   END;
  245.  
  246.   ELSE RETURN FALSE; (* don't handle this event *)
  247.   END;(*case*)
  248.  END;(*with*) END;(*with*) END CSWHandler;
  249.  
  250.  PROCEDURE MakeControls;
  251.   CONST visible=TRUE;
  252.   VAR Title:ARRAY[0..40] OF CHAR; boundsRect:Rect;
  253.   BEGIN WITH CSData DO
  254.     SetRect(boundsRect,40,20,240,35); MakePascalString("bar1",Title);
  255.     bar1:=NewControl(CSW,boundsRect,ADR(Title),visible,50,0,100,
  256.                      ScrollBarProc,11223344);
  257.     SetRect(boundsRect,5,40,20,300); MakePascalString("bar2",Title);
  258.     bar2:=NewControl(CSW,boundsRect,ADR(Title),visible,0,-1000,+1000,
  259.                      ScrollBarProc,11223344);
  260.  
  261.     SetRect(boundsRect,50,50,120,70); MakePascalString("button1",Title);
  262.     button1:=NewControl(CSW,boundsRect,ADR(Title),visible,0,0,1,
  263.                         PushButProc,11223344);
  264.     SetRect(boundsRect,150,50,220,70); MakePascalString("button2",Title);
  265.     button2:=NewControl(CSW,boundsRect,ADR(Title),visible,1,0,1,
  266.                         PushButProc,11223344);
  267.  
  268.     SetRect(boundsRect,50,100,95,125); MakePascalString("rb1",Title);
  269.     rb1:=NewControl(CSW,boundsRect,ADR(Title),visible,0,0,1,
  270.                         RadioButProc,11223344);
  271.     SetRect(boundsRect,100,100,145,125); MakePascalString("rb2",Title);
  272.     rb2:=NewControl(CSW,boundsRect,ADR(Title),visible,1,0,1,
  273.                         RadioButProc,11223344);
  274.     SetRect(boundsRect,150,100,195,125); MakePascalString("rb3",Title);
  275.     rb3:=NewControl(CSW,boundsRect,ADR(Title),visible,0,0,1,
  276.                         RadioButProc,11223344);
  277.     SetRect(boundsRect,200,100,245,125); MakePascalString("rb4",Title);
  278.     rb4:=NewControl(CSW,boundsRect,ADR(Title),visible,1,0,1,
  279.                         RadioButProc,11223344);
  280.  
  281.     SetRect(boundsRect,50,150,100,175); MakePascalString("chk1",Title);
  282.     chk1:=NewControl(CSW,boundsRect,ADR(Title),visible,1,0,1,
  283.                         CheckBoxProc,11223344);
  284.     SetRect(boundsRect,50,175,100,200); MakePascalString("chk2",Title);
  285.     chk2:=NewControl(CSW,boundsRect,ADR(Title),visible,0,0,1,
  286.                         CheckBoxProc,11223344);
  287.     SetRect(boundsRect,50,200,100,225); MakePascalString("chk3",Title);
  288.     chk3:=NewControl(CSW,boundsRect,ADR(Title),visible,1,0,1,
  289.                         CheckBoxProc,11223344);
  290.     SetRect(boundsRect,50,225,100,250); MakePascalString("chk4",Title);
  291.     chk4:=NewControl(CSW,boundsRect,ADR(Title),visible,0,0,1,
  292.                         CheckBoxProc,11223344);
  293.   END;(*with*)END MakeControls;
  294.  
  295.  PROCEDURE RemoveControls;
  296.   BEGIN WITH CSData DO
  297.     KillControls(CSW);
  298.    END; END RemoveControls;
  299. (*-----------------------------------------------------------------------------*)
  300. VAR MacNIL:ADDRESS; mainPort:GrafPtr;
  301.  
  302. PROCEDURE EnterMain;
  303.  (* initialize the main program *)
  304.  BEGIN MacNIL:=000000H; GetPort(mainPort);
  305.        FlushEvents(everyEvent,0);
  306.  END EnterMain;
  307.  
  308. PROCEDURE LeaveMain;
  309.  (* undo the main program setup*)
  310.  BEGIN SetPort(mainPort);
  311.  END LeaveMain;
  312.  
  313. PROCEDURE RunMainLoop;
  314.   VAR Mzeile,zeile: ARRAY[0..80] OF CHAR;
  315.       theEvent:EventRecord; echo:OsErr;
  316.  BEGIN ClearTerminal;
  317.        REPEAT WriteString("->"); ReadString(Mzeile);
  318.               MakePascalString(Mzeile,zeile);
  319.               IF ORD(zeile[0])=0
  320.                THEN (* do nothing*)
  321.                ELSE CASE CAP(zeile[1])
  322.                     OF "Q": echo:=PostEvent(abortEvt,0);
  323.                     ELSE (*DrawString(ADR(zeile)); *) WriteString(Mzeile); WriteLn;
  324.                     END;(*case*)
  325.                END;(*if*)
  326.        UNTIL EventAvail(abortMask,theEvent);
  327.  END RunMainLoop;
  328.  
  329. (*-----------------------------------------------------------------------------*)
  330. BEGIN (*body of smallControl*)
  331.  EnterMain;           EnterTestScreen;   EnterControlScreen;
  332.  RunMainLoop;
  333.  LeaveControlScreen;  LeaveTestScreen;   LeaveMain;
  334. END smallControl.
  335.